home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok58.lha / NPrint / txt / Trenne.mod < prev    next >
Text File  |  1993-08-15  |  8KB  |  361 lines
  1.  
  2. (**********************************************************************
  3.  
  4.     :Program.    Trenne
  5.     :Contents.   Insert hyphens in a word (german)
  6.     :Author.     Toolbox 4 89 Matthias Uphoff (Turbo Pascal)
  7.     :Author.     Ported to M2 by Oliver Schersand
  8.     :Address.    Schillerstr 4 7805 Bötzingen
  9.     :Phone.      07663/3049
  10.     :Copyright.  Public Domain
  11.     :Language.   Modula-2
  12.     :Translator. M2Amiga AMSoft 3.3d
  13.     :History.    V1.0 11.02.1990
  14.  
  15. **********************************************************************)
  16.  
  17. (* $V- $R- $S- $F- *)
  18. IMPLEMENTATION MODULE Trenne;
  19.  
  20. IMPORT ASCII;
  21.  
  22. FROM Arts IMPORT Assert;
  23.  
  24. FROM SYSTEM IMPORT ADR;
  25.  
  26. FROM FileSystem IMPORT Lookup,Close,ReadChar,Response,File;
  27.  
  28. FROM Str      IMPORT FirstPos,Length;
  29.  
  30. FROM Strings IMPORT Insert;
  31.  
  32. CONST
  33.  
  34. MaxTS = 40;
  35.  
  36. TYPE
  37.  
  38. Str350 = ARRAY[0..350] OF CHAR;
  39. Str300 = ARRAY[0..300] OF CHAR;
  40. Str150 = ARRAY[0..150] OF CHAR;
  41. Str100 = ARRAY[0..100] OF CHAR;
  42. Str50  = ARRAY[0..50 ] OF CHAR;
  43.  
  44. TSArray = ARRAY[0..MaxTS] OF INTEGER;
  45.  
  46.  
  47. VAR
  48.  
  49. BeginnAusnahmen   : Str150;
  50. Vorsilben         : Str150;
  51. BeginnSpezial     : Str300;
  52. Beginn5           : Str150;
  53. Beginn4           : Str150;
  54. Beginn3           : Str150;
  55. Beginn2           : Str150;
  56. Diphthong         : Str150;
  57. VokalTrenn        : Str150;
  58. KonsonantBeginn   : Str150;
  59. KonsonantEnde     : Str350;
  60. SilbenEnde        : Str150;
  61. Nachsilben        : Str100;
  62. VokalSilben       : Str350;
  63. Konsonanten       : Str150;
  64. Vokale            : Str150;
  65. Buchstaben        : Str100;
  66.  
  67. TabOnDisk         : BOOLEAN; (* Ob die Tabellen schon geladen *)
  68.  
  69.  
  70. PROCEDURE InListe(    Liste  : ARRAY OF CHAR;
  71.                   VAR Zeile  : ARRAY OF CHAR;
  72.                   VAR Laenge : INTEGER;
  73.                       p      : INTEGER)       : BOOLEAN;
  74.  
  75. VAR i,q : INTEGER;
  76.  
  77. BEGIN
  78.  i := 0;
  79.  q := p;
  80.  Assert(p >= 0 ,ADR("Scheisse"));
  81.  WHILE Liste[i] <= Zeile[q]  DO
  82.    WHILE (Liste[i] = Zeile[q]) & (Liste[i] # " ")  DO
  83.      INC(i);INC(q);
  84.    END; (* WHILE (Liste[i] = Zeile[q]) & (Liste[i] # " ") *)
  85.    IF Liste[i] = " " THEN
  86.      Laenge := q-p;
  87.      RETURN TRUE;
  88.    ELSE
  89.     REPEAT INC(i) UNTIL Liste[i] = " ";
  90.    END;
  91.    INC(i); q := p;
  92.  END; (* WHILE Liste[i] <= Zeile[q] *)
  93.  Laenge := q-p;
  94.  RETURN FALSE;
  95. END InListe;
  96.  
  97.  
  98.  
  99. PROCEDURE SilbenTrennung(    Zeile       : ARRAY OF CHAR;
  100.                          VAR Anzahl      : INTEGER;
  101.                          VAR TrennStelle : TSArray);
  102.  
  103.  
  104. VAR
  105.  
  106. p,
  107. Laenge,
  108. Startp,Endp,
  109. linksp       : INTEGER;
  110.  
  111. getrennt : BOOLEAN;
  112.  
  113.   PROCEDURE UpperCase(VAR Zeile : ARRAY OF CHAR);
  114.  
  115.   VAR i : INTEGER;
  116.  
  117.   BEGIN
  118.    IF Length(Zeile)=0 THEN RETURN END;
  119.    FOR i := 0 TO Length(Zeile)-1 DO
  120.      CASE Zeile[i] OF
  121.       | "ä" : Zeile[i] := "Ä";
  122.       | "ö" : Zeile[i] := "Ö";
  123.       | "ü" : Zeile[i] := "Ü";
  124.      ELSE
  125.       Zeile[i] := CAP(Zeile[i])
  126.      END;
  127.    END;
  128.   END UpperCase;
  129.  
  130.   PROCEDURE Registriere(p : INTEGER);
  131.  
  132.   BEGIN
  133.    IF (p > Startp+1) & (p < Endp-1) THEN
  134.      IF Anzahl < MaxTS THEN
  135.        INC(Anzahl);
  136.        TrennStelle[Anzahl] := p;
  137.      END;
  138.      Startp := p;
  139.    END;
  140.    getrennt := TRUE;
  141.   END Registriere;
  142.  
  143.   PROCEDURE SilbenStart(p : INTEGER) : BOOLEAN;
  144.  
  145.   BEGIN
  146.    IF    (FirstPos(Vokale,0,Zeile[p]  ) # -1) OR
  147.          (FirstPos(Vokale,0,Zeile[p+1]) # -1) THEN RETURN TRUE
  148.    ELSIF InListe(KonsonantBeginn,Zeile,Laenge,p) &
  149.          (FirstPos(Vokale,0,Zeile[p+Laenge]) # -1) &
  150.          (Zeile[p-1] # "C")                   THEN RETURN TRUE
  151.    ELSE  RETURN FALSE END
  152.   END SilbenStart;
  153.  
  154.   PROCEDURE Wortbeginn(VAR p : INTEGER);
  155.  
  156.    PROCEDURE VorTest(lng : INTEGER);
  157.  
  158.    BEGIN
  159.     IF SilbenStart(p+lng) THEN
  160.       INC(p,lng);
  161.       Registriere(p)
  162.     END;
  163.    END VorTest;
  164.  
  165.   BEGIN
  166.    IF NOT InListe(BeginnAusnahmen,Zeile,Laenge,p) THEN
  167.      IF InListe(Vorsilben,Zeile,Laenge,p) THEN
  168.        VorTest(Laenge);
  169.        IF InListe(Vorsilben,Zeile,Laenge,p) THEN
  170.          VorTest(Laenge)
  171.        END;
  172.      END;
  173.      IF    InListe(BeginnSpezial,Zeile,Laenge,p) & (Zeile[p+Laenge] # "E") THEN
  174.        VorTest(Laenge)
  175.      ELSIF InListe(Beginn5,Zeile,Laenge,p) THEN
  176.        VorTest(5)
  177.      ELSIF InListe(Beginn4,Zeile,Laenge,p) THEN
  178.        VorTest(5)
  179.      ELSIF InListe(Beginn3,Zeile,Laenge,p) THEN
  180.        VorTest(3)
  181.      ELSIF InListe(Beginn2,Zeile,Laenge,p) THEN
  182.        VorTest(2)
  183.      END;
  184.    END;
  185.   END Wortbeginn;
  186.  
  187.   PROCEDURE VokalVokal(linksp,rechtsp : INTEGER);
  188.  
  189.   BEGIN
  190.    IF (rechtsp-linksp >= 2) THEN
  191.      IF  InListe(VokalTrenn,Zeile,Laenge,linksp) & (Zeile[linksp-1] # "Q") THEN
  192.        Registriere(linksp+1)
  193.      ELSIF rechtsp-linksp >= 3 THEN
  194.        IF InListe(Diphthong,Zeile,Laenge,linksp) THEN
  195.          Registriere(linksp+2)
  196.        END
  197.      END;
  198.    END;
  199.   END VokalVokal;
  200.  
  201.   PROCEDURE KonsonantVokal(linksp : INTEGER);
  202.  
  203.   VAR p,rechtsp : INTEGER;
  204.  
  205.   BEGIN
  206.    rechtsp := linksp;
  207.    WHILE NOT SilbenStart(linksp)  DO
  208.      INC(linksp)
  209.    END; (* WITH NOT SilbenStart(linksp) *)
  210.    IF InListe(KonsonantEnde,Zeile,Laenge,rechtsp) THEN
  211.      INC(rechtsp,Laenge)
  212.    END; (* IF InListe(KonsonantEnde,Zeile,Laenge,rechtsp) *)
  213.    IF linksp < rechtsp THEN
  214.      p := linksp;
  215.      REPEAT
  216.        IF    (InListe(Nachsilben,Zeile,Laenge,p)) THEN
  217.          linksp := p
  218.        ELSIF getrennt & (p>3) THEN
  219.          IF  InListe(SilbenEnde,Zeile,Laenge,p-4) THEN linksp := p
  220.          ELSE INC (p)  END;
  221.        ELSIF   (InListe(VokalSilben,Zeile,Laenge,p))   THEN
  222.          linksp := p
  223.        ELSE
  224.         INC(p);
  225.        END;
  226.      UNTIL (p > rechtsp) OR (p = linksp);
  227.    END; (* IF linksp < rechtsp *)
  228.    Registriere(linksp);
  229.   END KonsonantVokal;
  230.  
  231. BEGIN
  232.  UpperCase(Zeile);
  233.  Anzahl := 0;
  234.  Endp   := 0;
  235.  
  236.  REPEAT
  237.   Startp := Endp;
  238.   WHILE (FirstPos(Buchstaben,0,Zeile[Startp]) = -1) &
  239.         (Startp <= INTEGER(Length(Zeile))) DO
  240.    INC(Startp)
  241.   END;
  242.   Endp := Startp;
  243.   WHILE (FirstPos(Buchstaben,0,Zeile[Endp]) # -1) DO INC(Endp) END;
  244.  
  245.   IF Endp - Startp >= 4 THEN
  246.     getrennt := FALSE;
  247.     p := Startp;
  248.     Wortbeginn(p);
  249.     WHILE FirstPos(Konsonanten,0,Zeile[p]) # -1  DO INC(p) END;
  250.  
  251.     WHILE FirstPos(Buchstaben,0,Zeile[p]) # -1  DO
  252.       linksp := p;
  253.       WHILE FirstPos(Vokale,0,Zeile[p]) # -1 DO INC(p) END;
  254.       VokalVokal(linksp,p);
  255.       linksp := p;
  256.       WHILE FirstPos(Konsonanten,0,Zeile[p]) # -1 DO INC(p) END;
  257.       IF FirstPos(Vokale,0,Zeile[p]) # -1 THEN KonsonantVokal(linksp) END;
  258.     END; (* WHILE FirstPos(Buchstaben,0,Zeile[p]) # -1 *)
  259.   END; (* IF Endp - Startp >= 4 *)
  260.  UNTIL Startp = Endp;
  261. END SilbenTrennung;
  262.  
  263.  
  264.  
  265. PROCEDURE TabellenLaden(datei : ARRAY OF CHAR);
  266.  
  267. VAR ch : CHAR;
  268.     In : File;
  269.  
  270.  PROCEDURE GetCh;
  271.  
  272.  VAR lst : CHAR;
  273.  
  274.  BEGIN
  275.   REPEAT
  276.     lst := ch;
  277.     ReadChar(In,ch); IF ch < " " THEN ch := " " END;
  278.   UNTIL (ch  # " ") OR (lst # " ") OR In.eof;
  279.   IF (ch = "#") OR In.eof  THEN ch := CHAR(255) END;
  280.  END GetCh;
  281.  
  282.  
  283.  PROCEDURE TabLoad(n : Str100;VAR a : ARRAY OF CHAR);
  284.  
  285.  VAR i : INTEGER;
  286.  
  287.  BEGIN
  288.   ch := " ";
  289.   GetCh;
  290.   Assert(ch = ";",ADR("Datei hat falsche Format"));
  291.   ch := " ";i := 0;
  292.   LOOP
  293.    GetCh;
  294.    IF ch # n[i] THEN EXIT END;
  295.    INC(i);
  296.   END;
  297.   Assert((ch = " ") AND (n[i] = 0C),ADR("Falsche Reihenfolge"));
  298.   i := 0;
  299.   REPEAT
  300.    GetCh;
  301.    a[i] := ch; INC(i);
  302.   UNTIL ch = CHAR(255);
  303.   a[i] := 0C;
  304.  END TabLoad;
  305.  
  306.  
  307. BEGIN
  308.  Lookup(In,datei,4096,FALSE);
  309.  IF In.res = done THEN
  310.   TabLoad("BeginnAusnahmen",BeginnAusnahmen);
  311.   TabLoad("Vorsilben",Vorsilben);
  312.   TabLoad("BeginnSpezial",BeginnSpezial);
  313.   TabLoad("Beginn5",Beginn5);
  314.   TabLoad("Beginn4",Beginn4);
  315.   TabLoad("Beginn3",Beginn3);
  316.   TabLoad("Beginn2",Beginn2);
  317.   TabLoad("Diphthong",Diphthong);
  318.   TabLoad("VokalTrenn",VokalTrenn);
  319.   TabLoad("KonsonantBeginn",KonsonantBeginn);
  320.   TabLoad("KonsonantEnde",KonsonantEnde);
  321.   TabLoad("SilbenEnde",SilbenEnde);
  322.   TabLoad("Nachsilben",Nachsilben);
  323.   TabLoad("VokalSilben",VokalSilben);
  324.  END;
  325.  Buchstaben  := "ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜß";
  326.  Vokale      := "AEIOUYÄÖÜ";
  327.  Konsonanten := "BCDFGHJKLMNPQRSTVWXZß";
  328.  Close(In);
  329. END TabellenLaden;
  330.  
  331.  
  332. PROCEDURE Trennstrich(VAR Zeile     : ARRAY OF CHAR;
  333.                           TrennChar : CHAR);
  334.  
  335. VAR
  336.  i,j,k,an : INTEGER;
  337.  ta    : TSArray;
  338.  tren  : ARRAY[0..1] OF CHAR;
  339.  
  340. BEGIN
  341.  IF TabOnDisk THEN
  342.    TabellenLaden("devs:TrennTab.txt");
  343.    TabOnDisk := FALSE;
  344.  END;
  345.  tren[0] := TrennChar;
  346.  tren[1] := 0C;
  347.  SilbenTrennung(Zeile,an,ta);
  348.  k := 0;
  349.  FOR i := 1 TO an DO
  350.   j := ta[i]+k;
  351.   Insert(Zeile,j,tren);
  352.   IF (CAP(Zeile[j-1]) = "C") AND (CAP(Zeile[j]) = "K") THEN Zeile[j-1] := "k" END;
  353.   INC(k);
  354.  END;
  355. END Trennstrich;
  356.  
  357. BEGIN
  358.  TabOnDisk := TRUE;
  359. END Trenne.
  360.  
  361.